--- Internal form of abstract Java and instances 
module Compiler.gen.java.PrettyJava where

import frege.Prelude hiding(<+>, break)

import Compiler.enums.Flags(COMMENTS, isOn)

import Compiler.types.AbstractJava
import Compiler.common.Annotate
import Compiler.common.AnnotateG(notNil, AnnoG)
import Lib.PP hiding (line)
import Data.Bits(BitSet(member))
import Compiler.common.Mangle(mangleJtv)
import Compiler.common.Roman(romanUpper)
import Compiler.types.JNames
import Compiler.types.Global(Global, GenSt, abbreviate, targetName)
import Compiler.common.CompilerOptions(stdOptions)

--- a special marker used for the @Thunk@ type.
--- It will be resolved using 'targetName' instead of 'abbreviate'
thunkMarker = "«Thunk»"

instance Anno JAttr where
    anno JFinal     = text "final"
    anno JPrivate   = text "private"
    anno JPublic    = text "public"
    anno JProtected = text "protected"
    anno JStatic    = text "static"
    anno JAbstract  = text "abstract"
    anno JDefault   = text "default"
    anno JFunctionalInterface = text "@FunctionalInterface"
    anno JOverride  = text "@Override"
    anno JUnchecked = text "@SuppressWarnings(\"unchecked\")"
    anno JRawTypes  = text "@SuppressWarnings(\"rawtypes\")"


--- annotate attributes
annoAttrs :: Attributes -> DOCUMENT
annoAttrs flags
    | null flags = PP.nil
    | otherwise  = (PP.spread . map anno . filter (BitSet.`member` flags)) [minBound .. maxBound]

instance AnnoG JTVar where
    annoG g (JTVar s UNBOUNDED)     = text (mangleJtv g s)
    annoG g (JTVar s (SUPER jt))    = text (mangleJtv g s) <+> text "super" <+> annoG g jt
    annoG g (JTVar s (EXTENDS jts)) = text (mangleJtv g s) <+> text "extends" 
                                         <+> sep " &" (map (annoG g) jts)
    annoListG g = annoSomeG g "<" "," ">" 

--- annotate formal and actual generic arguments
annoGenerics g [] = DOCUMENT.NONE
annoGenerics g xs = annoSomeG g "<" "," ">" xs

instance AnnoG JType where
    annoG g (Ref    {jname,gargs})     = text (show jname) <> annoGenerics g gargs
    annoG g (Constr {jname,gargs})     = text (show jname) <> annoGenerics g gargs
    annoG g (TArg var          )       = text (mangleJtv g var)
    annoG g Wild{bounds}               = annoG g (JTVar "?" bounds)

    --annoG g Nativ{typ="[]",
    --           gargs=[ta@TArg var]}    = annoG g Something 
    --                                        <> text "/*"
    --                                        <> annoG g ta 
    --                                        <> text "[]*/"
    annoG g Nativ{typ="[]",
               gargs=[jt]}             = annoG g jt <> text "[]"
    annoG g Nativ {typ,gargs,generic}  = text (if typ == thunkMarker 
                                                    then targetName g "Thunk" 
                                                    else abbreviate g typ)  
                                            <> if generic then annoGenerics g gargs 
                                                else if null gargs then PP.nil
                                                else bracket "/*" (annoGenerics g xargs) "*/"
                            -- make sure we dont get    java.util.EnumSet/*<Enum/*<𝓔>*/>*/> 
                            where xargs = map fakeGeneric gargs
                                  fakeGeneric Nativ{typ, gargs, generic}
                                                    = Nativ typ (map fakeGeneric gargs) true
                                  fakeGeneric jt | jt.{gargs?} = jt.{gargs ← map fakeGeneric}
                                                 | otherwise   = jt
    annoG g Kinded{arity, gargs}       = text (abbreviate g "frege.run.Kind"++".") 
                                                <> text (romanUpper arity) 
                                                <> annoGenerics g gargs
    annoG g (Lazy {yields})            = text (targetName g "Lazy" ++ "<") 
                                            <> annoG g yields <> text ">"
    annoG g Func{gargs}                = text (targetName g "Func" ++ ".") 
                                        <> text (romanUpper (length gargs - 1))
                                        <> annoGenerics g gargs
    annoG g Something                  = text (abbreviate g "java.lang.Object")

--- nowarn: no warnings concerning performUnsafe
fakeGlobal = Global.{gen ← GenSt.{main="Blubb"}}
    -- sorry!!!
    -- I could also list all those unimportant fields 
    (IO.performUnsafe CompilerOptions.standardGlobal)

instance Show JType where
    show jt = nice.replaceAll´\n\s*´ " " 
        where
            nice = pretty 100 (annoG fakeGlobal jt)

--- subex e x
--- print @x@ or @(x)@ depending on relative precedence to @e@
subexG :: Global → JExpr → JExpr → PP.DOCUMENT
subexG g e x
          | e.prec == 3 && x.prec <= 3  = text "(" <> annoG g x <> text ")"
          | x.prec < e.prec             = text "(" <> annoG g x <> text ")"
          | otherwise                   = annoG g x


instance AnnoG JExpr where
    annoListG g = annoSomeG g "(" "," ")"
    annoG g (JAtom {name}) = text name
    annoG g (JNew jt exs) = text "new" <+> annoG g jt <> annoListG g exs
    annoG g (e@JInvoke (JExMem jex s gs) exs) = (e `subex` jex) <~/> PP.nest 4 (
                                    text "." <> annoGenerics g gs 
                                    <> text s <> annoListG g exs)
                where subex = subexG g
    -- anno (e@JInvoke (JExMemG jex s gs) exs) = e.subex jex <~/> PP.nest 4 (
    --                                text "." <> annoGenerics gs <> text s <> annoList exs)
    annoG g (e@JInvoke x exs) = (e `subex` x) <> PP.nest 4 (annoListG g exs)
                where subex = subexG g
    annoG g (it@JCast jt JLambda{fargs, code})
        | not g.hasLambdaSupport,
          itsLazy jt || itsFunc jt = annoG g (lambda7 it)

    annoG g (e@JCast jt x) = text "(" <> annoG g jt <> text ")" <> (e `subex` x)
                where subex = subexG g
    annoG g JStMem{jt, name, targs} = annoG g jt <> text "." 
                                        <> annoGenerics g targs <> text name  
    annoG g (e@JExMem jex s gs) = (e `subex` jex) <> text "." <> annoGenerics g gs <> text s
                where subex = subexG g
    annoG g (un@JUnop op j1) = text op <+> (un `subex` j1)
                where subex = subexG g
    annoG g (bin@JBin j1 op j2) = (bin `subex` j1) <+> text op <+> (bin `subex` j2)
                where subex = subexG g
    annoG g (jqc@JQC j1 j2 j3) = (bracket "(" (jqc `subex` j1) ")")
                        <+> PP.nest 4    (text "?" <+> (jqc `subex` j2)
                                    <+/> (text ":" <+> (jqc `subex` j3)))
                where subex = subexG g
    annoG g (get@JArrayGet{j1, j2}) = (get `subex` j1) <> text "[" <> annoG g j2 <> text "]"
                where subex = subexG g
    annoG g (JNewClass jt exs decls)  = text "new"
                            <+> ann g jt
                            <>  annoListG g exs
                            <+> annoListG g decls
        where 
            -- here (and only here) we use the .D default inner abstract classes of Lazy/Func
            ann g (Lazy {yields})
                | not g.hasLambdaSupport = text (targetName g "Lazy" ++ ".D<") 
                                            <> annoG g yields <> text ">"
            ann g Func{gargs}
                | not g.hasLambdaSupport = text (targetName g "Func" ++ ".") 
                                            <> text (romanUpper (length gargs - 1))
                                            <> text ".D"
                                            <> annoGenerics g gargs
            ann g x                 = annoG g x
    annoG g JLambda{fargs, code} = annoArgDef g fargs 
                                <+> PP.nest 4 (
                                        text "->" 
                                        <+> either (annoG g) (annoG g) code)
    annoG g (JNewArray jt ex)
        | Nativ{typ="[]", gargs=[it]} <- jt 
                     = text "new"
                            <+> annoG g (rawType it)
                            <>  text "[" <> annoG g ex <> text "]"
        | otherwise  = text "new"
                            <+> annoG g jt
                            <>  text "[" <> annoG g ex <> text "]"

itsLazy jt = case jt of 
    Lazy{}  → true
    _       → false
itsFunc jt = case jt of
    Func{}  → true
    _       → false

lambda7 ∷ JExpr → JExpr
lambda7  (JCast jt JLambda{fargs, code})
        | itsLazy jt || itsFunc jt = newfunc
        where
            y (Lazy t) = t
            y (Func gs) = last gs
            y _ = Something
            lazy t = case t of
                Lazy{} → t
                y      → Lazy y
            newfunc = JNewClass{jt, args=[], 
                decls = if itsLazy jt then [lzcall] else [apply]}
            lzcall = JMethod{
                attr = BitSet.fromList [JPublic], 
                gvars = [], 
                jtype = y jt, 
                name = "call", args = fargs, 
                body = either (JBlock . (:[]) . JReturn) id code}
            apply = lzcall.{name = "apply", jtype ← lazy}
            -- fncall = lzcall.{jtype = jt, args = [], body = JBlock [JReturn (JAtom "this")]}
            -- fnAsThunk = fncall.{jtype ← nativ thunkMarker . pure, 
            --                    args = [],
            --                    name="asThunk", 
            --                    body = JBlock [JReturn (JAtom "null")]}
            -- lzAsThunk = fnAsThunk.{jtype = nativ thunkMarker . pure $ lzcall.jtype}
lambda7 other = other

instance AnnoG JStmt where
    annoG g (JError s) = annoG g (JComment s) </> text "FIX: incomplete code generation;"
    annoG g JEmpty = text ";"
    annoG g (JBlock []) = text "{}"
    annoG g (JBlock stmts) = PP.block "{" (PP.stack statements) "}"
        where statements = filter notNil (map (annoG g) stmts)
    annoG g (JReturn ex) = text "return" <+> PP.nest 4 (annoG g (postOpt ex) <> text ";")
    annoG g (JThrow ex)  = text "throw"  <+> PP.nest 4 (annoG g (postOpt ex) <> text ";")
    annoG g (JAssert ex) = text "assert" <+> PP.nest 4 (annoG g (postOpt ex) <> text ";")
    annoG g (JEx ex) = annoG g (postOpt ex) <> text ";"
    annoG g (JAssign x1 x2) = (annoG g x1) 
                                <+> text "=" 
                                <+> annoG g (postOpt x2) 
                                <> text ";"
    annoG g (JLocal jdecl) = annoG g jdecl
    annoG g (JCond k x stmts) = text k <+> bracket "(" (annoG g (postOpt x)) ")"
                        <+>  annoG g  (JBlock stmts)
    annoG g (JBlockX k stmts) = text k <+> annoG g (JBlock stmts)
    annoG g (JCase x stmt) = text "case" <+> annoG g x <> text ":" <+> annoG g stmt

--- annotate list of classes that are implemented
annoImplements g _ []  = PP.nil
annoImplements g s [x] = text s <+> annoG g x
annoImplements g s xs  = nest 2 $ text s <+/> PP.sep "," (map (annoG g) xs)

--- annotate a formal method argument
annoArg :: Global → FormalArg → DOCUMENT
annoArg g (n, _, jt, s) = annoAttrs n <+> annoG g jt <+> text s


--- annotate a formal argument list
annoArgDef g []   = text "()"
annoArgDef g args = bracket "(" (PP.sep "," (map (annoArg g) args)) ")"


--- 'JDecl's are annotatable
instance AnnoG JDecl where
    annoListG g xs = block "{" (items xs) "}"
        where items = stack . filter notNil . map (annoG g)  
    annoG g (JComment s)       = if isOn g.options.flags COMMENTS
                                    then text "// " <> text s -- <> PP.line
                                    else PP.nil
    annoG g (cl@JClass {attr}) = annoAttrs attr <+> text "class"
                        <+> (text cl.name <> annoGenerics g cl.gvars)
                        <+> bracket ""
                             (maybe PP.nil ((text "extends" <+>) • JType.annoG g) cl.extend
                             <+> annoImplements g "implements" cl.implement) ""
                        <+> annoListG g cl.defs
    annoG g (cl@JInterface {attr}) = annoAttrs attr <+> text "interface"
                        <+> (text cl.name <> annoGenerics g cl.gvars)
                        <+> bracket "" (annoImplements g "extends" cl.implement) ""
                        <+> annoListG g cl.defs

    annoG g (m@JMethod {attr}) = annoAttrs m.attr
                        <+> annoGenerics g (m.gvars)
                        <+> annoG g m.jtype
                        <+> text m.name
                        <> annoArgDef g m.args
                        <+> annoG g m.body
    annoG g (m@JConstr {attr}) = annoAttrs m.attr
                        <+> annoG g xtype
                        <> annoArgDef g m.args
                        <+> annoG g m.body
            where
                xtype | m.jtype.{gargs?} = m.jtype.{gargs=[]}
                      | otherwise        = m.jtype
    annoG g (m@JMember {attr}) = annoAttrs m.attr
                        <+> annoG g m.jtype <+> text m.name
                        <+>  maybe PP.nil (const (text "=")) m.init
                        <+/> maybe PP.nil (JExpr.annoG g • postOpt) m.init
                        <> text ";"
    annoG g JWhile{body} = text "while (true)" <+> annoG g body
